COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry WHEAD
C00007 ENDMK
C⊗;
entry WHEAD
title WHEAD
subttl Generate Sound file Header from SAIL call

comment ⊗
External procedure WHEAD(reference real array buf[1:128];
	integer clock,pack,nchans; real maxamp; string id);

clock = actual clock rate in samples per second
pack = 0 for 12bit, 1 for 16bit, 2 for FPI, 3 for 36-bit floating point
nchans = 1 for Mono, 2 for Stereo, 4 for Quad
maxamp is the maximum amplitude if known, 0 otherwise
⊗
; A Sound file header looks like this . . .
; WD 0 - 525252525252
; WD 1 - Clock rate
;	has code in LH, actual rate in RH
;	code=0 for 6.4Kc (or anything else)
;	    =1 for 12.8Kc, =2 for 25.6Kc, =3 for 51.2Kc
;	    =5 for 102.4Kc, =6 for 204.8Kc
; WD 2 - pack
;	0 for 12 bit
;	1 for 16 bit (18 bit)
;	2 for 9 bit floating point incremental
;	3 for 36-bit floating point
;	has # samples per word in LH.
; WD 3 - # channels
;	1 for MONO
;	2 for STEREO
;	4 for QUAD
; WD 4 - Maximum amplitude (if known)
;	is a floating point number
;	is zero if not known
;	is maximum magnitude (abs value) of signal
; WDs 5-77 Reserved for future expansion
; WDs 100-177 Text description of file (in ASCIZ format)

idloc←←0	; loc of 5252 . . .
cloc←←1		; Displacement of clock rate
ploc←←2		; Of packing word
chnloc←←3	; of number of channels
amploc←←4	; max amplitude
tloc←←100	; start of text

p←17
sp←16
ac1←1
ac2←2
ac3←3
ac4←4
ac5←5
b←6

maxloc←←-1
ncloc←←-2
pakloc←←-3
clkloc←←-4
bufloc←←-5
pd←←6

integer cnt,ptr

WHEAD:	pop sp,ptr
	pop sp,ac1
	hrrzm ac1,cnt

	move b,bufloc(p)
	setzm (b)
	movei ac1,1(b)
	hrli ac1,(b)
	blt ac1,177(b)		; Clear out the header

	move ac1,[525252525252]
	movem ac1,idloc(b)
	move ac1,clkloc(p)
	movem ac1,cloc(b)
	setz ac2,
	cain ac1,=6400
	jrst dpcod
	cain ac1,=12800
	movei ac2,1
	cain ac1,=25600
	movei ac2,2
	cain ac1,=51200
	movei ac2,3
	cain ac1,=102000
	movei ac2,4
	cain ac1,=204000
	movei ac2,5
dpcod:	hrlm ac2,cloc(b)

	move ac1,pakloc(p)
	movem ac1,ploc(b)
	skipl ac1
	caile ac1,3
	jrst [outstr [asciz /WHEAD - Illegal packing code. Will set to 12bit
/]
	      setz ac1,
	      jrst locd]
locd:	move ac2,(ac1)[3 ↔ 2 ↔ 4 ↔ 1]
	hrlm ac2,ploc(b)	; Set # samples per word

	move ac1,ncloc(p)
	movem ac1,chnloc(b)
	move ac1,maxloc(p)
	movem ac1,amploc(b)

	skipn ac1,cnt
	jrst ret
	caile ac1,<200-tloc>*5		; Only this many characters
	jrst [outstr [asciz /WHEAD - Too many characters in string. Will truncate.
/]
	      movei ac1,<200-tloc>*5
	      jrst cntd]
cntd:	move ac2,ptr
	add b,[point 7,tloc]
clp:	ildb ac3,ac2
	idpb ac3,b
	sojg ac1,clp

ret:	sub p,[xwd pd,pd]
	jrst @pd(p)

end